Mac Mania 2/MacMania 2.toast/Demo's/Tools&Utilities/Programming/FBSpriteWorld 1.05b/Project 1.05b/SWSpinningGlobe.11.main

Text File | 1994-05-10 | 17.0 KB | 517 lines | [TEXT/ZBAS]

'
'       FBSpinningGlobe.main by Robert Hommel
'       © Copyright 1994
'       All rights granted for any use whatsoever
'
'       ------------------------------------------------------------
'       Additional Modifications by: Andrew Gariepy
'
'       Works with 32 bit quickdraw only                    04/26/94
'       Added dialog & menu event handling for BG running
'       Reduced memory requirements by 1/3                  04/28/94
'       Fixed Power Mac problems
'       Fixed unlocked GWorld bugs                          04/29/94
'       Fixed numerous other things for speed & reliability
'
'       Testing for reliability was performed on a Mac IIfx, Q-700, Q-610,
'       and 840av, plus Power Macs 6100/60, 7100/66av, and 8100/80. All
'       tests were run under System 7.1 and 7.12.
'
'       The best speed we saw was the 8100 which achieved a frame rate
'       of 65 frames/sec (fps) at millions of colors. 256 colors peaked
'       the rate at about 80 fps. The 6100 could reach 65 fps when run
'       at 4 color mode. Remember though, this was under the emulator
'       which required thousands of mode switches per second of animation.
'       Not a bad speed considering.
'
'       ------------------------------------------------------------
'
'       This example program builds on the foundation of SWSimpleTest to
'       create a more complex animation.  It demonstrates the use of Sprites
'       with multiple Frames, the use of multiple Layers to produce a
'       three-dimensional appearance, and inactive (non-mobile) Sprites.
'
'       You will notice a slight slowing of the animation as the Globe
'       Sprites pass in front of or behind the SpriteWorld Text Sprite.
'       FBSpriteWorld does rigorous checking to make sure that only those
'       Sprites that have moved or changed frames are drawn.  Most of the
'       time, the Text Sprite does not need to be drawn; however, whenever
'       a Globe intersects the Text, FBSpriteWorld must render at least a
'       part of the Text Sprite, and this causes the animation to slow down.
'       This slowing is only noticeable because most of the Globe Sprites
'       are moved 'as quickly as possible.'  If this were anything other
'       than a demo, we would assign move times to each Globe Sprite suf-
'       ficient to keep them moving at a steady pace.
'
'       We can learn several lessons from the 'slowing' phenomenon: namely,
'       keep the number of Sprites to a minimum, keep the number of moving
'       Sprites as small as possible, avoid intersecting inactive Sprites,
'       and for optimum performance, keep the Sprites small.  If you must
'       have large Sprites, try to make them wide rather than tall.
'
'       When you click the mouse button to exit this program, an Alert will
'       display showing the number of animation frames performed per second.
'       On my original Mac LC, I get about 14.5 frames per second.  The
'       C version of SpriteWorld by Tony Myles clocks a cool 22 frames per
'       second using CopyBits, and 30+ with an assembly bit blitter!  Such
'       figures indicate we've got a long way to go with improving the
'       animation engine - any ideas out there?
'
'       Disclaimer:  I've tested these routines quite thoroughly on my Mac
'       LC running System 7.01 and FB 1.02c.
'       I make no promises or warranties of any kind.
'
'*********************************************************************
'
'TRON b
COMPILE 0, _MacsBugLabels _caseInsensitive
RESOURCES "FBSpriteWorld.RSRC","APPLFbSw"
'
'---------------------------- GLOBALS --------------------------------
'
GLOBALS "FBSpriteWorld.glbl"
'
_backPatRSRC     = 128
_spriteGlobeRSRC = 132
_spriteTextRSRC  = 228
'
_SpriteWnd = 1
_StatusWnd = 2
'
END GLOBALS
'
DIM T,L,B,R
DIM T1,L1,B1,R1
DIM curRect.8
DIM mySW.SpriteWorldRec
DIM myLayer.SWLayerRec(1)
DIM textLayer.SWLayerRec
DIM mySprite.SWSpriteRec(3)
DIM textSprite.SWSpriteRec
DIM myFrame.SWFrameRec(9)
DIM textFrame.SWFrameRec
DIM wndPort&
'
WINDOW OFF
GOTO "Main"
'
'--------------------------- INCLUDES --------------------------------
'
INCLUDE "FBSpriteWorld.incl"
'
'------------------------- ERROR HANDLER -----------------------------
'                       DestRect        Rect to Center
'       On Exit         DestRect        Centered in SourceRect
'
LOCAL
DIM ST,SL,SB,SR
DIM DT,DL,DB,DR
LOCAL FN CenterRects(SourceRect&,DestRect&)
   ST;8=SourceRect&                               '••• Get Rect's •••
   DT;8=DestRect&
   DeltaVert=ST+((SB-ST)-(DB-DT))/2-DT            '
   DeltaHorz=SL+((SR-SL)-(DR-DL))/2-DL
   DT=DT+DeltaVert
   DL=DL+DeltaHorz
   DB=DB+DeltaVert
   DR=DR+DeltaHorz
   BLOCKMOVE @DT,DestRect&,8                      '••• RETURN DEST RECT •••
END FN
'
'               FUNTION TO PRINT WHOLE WINDOW CONTENTS
'
LOCAL MODE
DIM T,L,B,R
DIM PT,PL,PB,PR
LOCAL FN PrintWindow(SWPtr&)
   DEF LPRINT
   LONG IF PRCANCEL=0                             '••• Not Canceled? •••
      CALL GETGWORLD(CurrPort&,CurrDev&)
      CALL SETGWORLD(SWPtr&.loadFramePtr&,0)
      T;8 = SWPtr&+_boundsRect
      Pict& = USR GETPICT(T)                      'take snapshot of background
      CALL SETGWORLD(CurrPort&,CurrDev&)
      LONG IF Pict&
         ROUTE 128
         PT=0 : PL=0 : PB=WINDOW(7) : PR=WINDOW(6)'Page Rectangle
         FN CenterRects(@PT,@T)                   '••• CENTER ON PAPER •••
         PICTURE (L,T),Pict&                      '••• SEND PICT TO PRINTER •••
         KILL PICTURE Pict&                       '••• DISPOSE OF PICTURE •••
         CALL PENNORMAL
         CALL FRAMERECT(T)
      END IF
   XELSE
      BEEP
   END IF
   CLOSE LPRINT
END FN
'
'
'
CLEAR LOCAL
LOCAL FN FatalError(errCode)
   '
   '     Simple error handler.  You'll want to improve on this in your
   '     program...
   '
   LONG IF errCode<>_noErr
      SELECT errCode
         CASE _swTooManyLayers     : errStr$="Out of Memory."
         CASE _swTooManySprites    : errStr$="Too many Sprites."
         CASE _swTooManyFrames     : errStr$="Too many Frames."
         CASE _swNotSystemSeven    : errStr$="SpriteWorld requires System 7!"
         CASE _swTimeMgrNotPresent : errStr$="SpriteWorld requires Time Manager."
         CASE _swOutOfMemory       : errStr$="Out of Memory."
         CASE ELSE                 : errStr$="Unknown error."
      END SELECT

      tmp$="Error Code:"+STR$(errCode)
      CALL PARAMTEXT(errStr$,tmp$,"","")
      x=FN STOPALERT(1,0)
      END
   END IF
END FN
'
'
'
CLEAR LOCAL MODE
LOCAL FN GetBestMonitor(@T&,TopHeight)
   gdHndl& = FN GETDEVICELIST                     'get first device in list
   MenuBar = {_Mbarheight}                        'If Main Monitor
   DO                                             'loop thu monitor list
      Depth = {[gdHndl&..gdPMap&]+_pmPixelSize}   'Current Depth
      LONG IF Depth > BestDepth
         BestDepth  = Depth
         BLOCKMOVE [gdHndl&]+_gdRect,T&,8         'send back the rect
         T&.Top% = T&.Top% + MenuBar + TopHeight
      END IF
      MenuBar = 0                                 'Not Main Monitor
      gdHndl& = FN GETNEXTDEVICE(gdHndl&)
   UNTIL gdHndl& = 0                              'till found or no more devices
END FN = BestDepth
'
'------------------------ SPRITEWORLD PROCS --------------------------
'
"SWBounceMoveProc"
ENTERPROC(SWPtr&,spritePtr&,curRectPtr&)
   '
   '     standard bounce movement proc.  Keeps sprite inside sprite boundsRect
   '
   dx = spritePtr&.xDelta%
   dy = spritePtr&.yDelta%
   LONG IF curRectPtr&.left%+dx          <= spritePtr&.sBoundsRect.left%
      spritePtr&.xDelta%   = -dx
   XELSE
      LONG IF curRectPtr&.right%+dx       >= spritePtr&.sBoundsRect.right%
         spritePtr&.xDelta% = -dx
      END IF
   END IF
   LONG IF curRectPtr&.top%+dy           <= spritePtr&.sBoundsRect.top%
      spritePtr&.yDelta%   = -dy
   XELSE
      LONG IF curRectPtr&.bottom%+dy      >= spritePtr&.sBoundsRect.bottom%
         spritePtr&.yDelta% = -dy
      END IF
   END IF
EXITPROC
RETURN
'
'       Sets the frameTTHasFired or moveTTHasFired field of the sprite record
'       to _zTrue (-1).  Called by the Time Manager if frameTimeInterval or
'       moveTimeInterval field of sprite record > 0.
'
"SWTimeTask"
`                 move.w      #-1,tmXQSize(a1)  ;[move|frame]TTHasFired=_zTrue
`                 rts                           ;return
'
'


'-------------------------- MAIN LOOP --------------------------------
'
"Main"

CURSOR _watchCursor                               'takes a few seconds to set up
OrigMem& = SYSTEM(_Memavail)
'
'--------------------------------------------------------------------
'Initialization and Set Up
'--------------------------------------------------------------------
'
err = FN SWEnterSpriteWorld                       'Can we run in this environment?
FN FatalError(err)
SWOpened = _ZTrue
'
'
'

'
'       Open a window and draw pretty background
'
FN GetBestMonitor(T1,20)                          'Find Best Screen
'
pict& = FN GETPICTURE(128)                        'BackGround Picture
CALL DETACHRESOURCE(pict&)
T;8 = [pict&]+2 : CALL OFFSETRECT(T,-L,-T)        'Size of Picture
FN CenterRect(T,T1)                               'Center on Best Monitor
WINDOW #_SpriteWnd,"Spinning Globe",(L,T)-(R,B),_Docnogrow_Nogoaway_Updatevisrgn'open a window the same size as PICT
COORDINATE WINDOW
CALL OFFSETRECT(T,-L,-T)                          'Remove Offset
PRINT %(R/2-60,B/2);"Building Sprite Worlds";
'
wndPort& = WINDOW(_WndPointer)                    'get grafPtr
'
'// NOTE:  At this point, it would be easier to create the      //
'// SpriteWorld based on the window port by using               //
'// SWCreateSWFromWindow, as we have in the other examples.     //
'// However, here we'll create the SpriteWorld from 'scratch'   //
'// with our own background PICT and bounding rectangle.  This  //
'// is the technique you would use to create a SpriteWorld with //
'// a bounding rectangle smaller than the window's PortRect, or //
'// to use a background different than the current background   //
'// of the window.                                              //
'
'
'       Create SpriteWorld
'

err = FN SWCreateSpriteWorld(@mySW,wndPort&,wndPort&+_portRect,pict&)
FN FatalError(err)
'
'       get time task ptr (same for all sprites)
'
ttPtr& = LINE "SWTimeTask"
'
'--------------------------------------------------------------------
'       Create Globe Sprites
'--------------------------------------------------------------------
'
'       get moveProc ptr (same for all sprites)
'
movePtr& = LINE "SWBounceMoveProc"
'
'       create first globe sprite
'
err=FN SWSpriteFromPict(@mySprite(0),0,0,0,wndPort&+_portRect,_zTrue,2,2,-1,ttPtr&,movePtr&,_spriteGlobeRSRC)
FN FatalError(err)
'
'       add frames to globe sprite (add frames before clonning!)
'
FOR x = 0 TO 9
   err = FN SWFrameFromPict(@myFrame(x),_spriteGlobeRSRC+(x*3))
   FN FatalError(err)
   err = FN SWAddFrameToSprite(@mySprite(0),@myFrame(x))
   FN FatalError(err)
NEXT
'
'       clone sprite(0) to make sprites 1-3
'
FOR x = 1 TO 3
   FN SWCloneSprite(@mySprite(0),@mySprite(x),ttPtr&)
NEXT
'
'       set sprite locations for sprites 1-3
'
FN SWSetSpriteLocation(@mySprite(1),R-60,0)
FN SWSetSpriteLocation(@mySprite(2),R-60,B-60)
FN SWSetSpriteLocation(@mySprite(3),0,B-60)
'
'       change sprite frame advance for sprites 1 and 3
'
FN SWSetSpriteFrameAdv(@mySprite(1),1)
FN SWSetSpriteFrameAdv(@mySprite(3),1)
'
'       change sprite move delta for sprites 0 and 2
'
FN SWSetMoveDelta(@mySprite(0),1,1)
FN SWSetMoveDelta(@mySprite(2),6,6)
'
'       set sprite move time for sprite 0 (all others will move as fast as they can)
'
FN SWSetMoveTime(@mySprite(0),200)
'
'       set sprite frame time for sprite 1 (all others will advance frames as fast as they can)
'
FN SWSetFrameTime(@mySprite(1),100)
'
'--------------------------------------------------------------------
'       Create Text Sprite
'--------------------------------------------------------------------
'
'// NOTE:  Normally, we use SWSpriteFromPict to create a sprite   //
'// that is based on a PICT resource, like our text sprite.  For  //
'// purposes of demonstration, we'll create this sprite from      //
'// 'scratch,' by calling SWInitSprite instead.  We'll extract    //
'// frameRect from the PICT resource, move it where we want it,   //
'// then pass it to the initialization routine.  SWInitSprite     //
'// would be most useful if you were making a sprite from some-   //
'// thing other than a PICT resource, such as an object drawn on  //
'// the screen.                                                       //
'
'       create frame first so we can easily get its rect
'
err=FN SWFrameFromPict(@textFrame,_spriteTextRSRC)
FN FatalError(err)
'
'       get frame rect
'
BLOCKMOVE @textFrame+_fBoundsRect,@curRect,8
'
'       center it in window rect
'
FN CenterRect(curRect,T)
'
'       create text sprite
'
FN SWInitSprite(@textSprite,0,@curRect,@T,_zTrue,0,0,0,ttPtr&,movePtr&)
'
'       set move and frame times to -1 (no frame advance or movement)
'
FN SWSetMoveTime (@textSprite,-1)
FN SWSetFrameTime(@textSprite,-1)
'
'       add frame to text sprite
'
err=FN SWAddFrameToSprite(@textSprite,@textFrame)
FN FatalError(err)
'
'---------------------------------------------------------------------
'       Assemble the Pieces
'---------------------------------------------------------------------
'
'       add globe sprites to globe layer 0
'
err=FN SWAddSpriteToLayer(@myLayer(0),@mySprite(0))
FN FatalError(err)
'
err=FN SWAddSpriteToLayer(@myLayer(0),@mySprite(1))
FN FatalError(err)
'
'       add text sprite to text layer
'
err=FN SWAddSpriteToLayer(@textLayer,@textSprite)
FN FatalError(err)
'
'       add globe sprites to globe layer 1
'
err=FN SWAddSpriteToLayer(@myLayer(1),@mySprite(2))
FN FatalError(err)
'
err=FN SWAddSpriteToLayer(@myLayer(1),@mySprite(3))
FN FatalError(err)
'
'       add layers to world
'
err=FN SWAddLayerToWorld(@mySW,@myLayer(0))
FN FatalError(err)
'
err=FN SWAddLayerToWorld(@mySW,@textLayer)
FN FatalError(err)
'
err=FN SWAddLayerToWorld(@mySW,@myLayer(1))
FN FatalError(err)
'
'---------------------------------------------------------------------
'       Final Set Up
'---------------------------------------------------------------------
'
'       Prepare loadframe for animation
'
FN SWRefreshBackground(@mySW)
'
CURSOR _arrowCursor                               'we're ready to go...
'
'       Render 1st frame of animation
'
FN SWAnimateSpriteWorld(@mySW)
'
'---------------------------------------------------------------------
'       Animation Loop
'---------------------------------------------------------------------
'
WINDOW #_StatusWnd,"Status Window",(2,40)-(230,100),_Docround_Nogoaway
TEXT 4,9,0,0
'
ON DIALOG   GOSUB "DIALOG"
ON STOP     GOSUB "STOP"
ON TIMER(2) GOSUB "TIMER"
ON MENU     GOSUB "MENU"
'
a& = FN TICKCOUNT : frames&=0                     'set initial timer vars
LastTime&  = FN TICKCOUNT
'
DO
   HANDLEEVENTS                                   'be kind to system
   FN SWProcessSpriteWorld(@mySW)                 'move sprites
   FN SWAnimateSpriteWorld(@mySW)                 'render sprites
   INC(frames&)                                   'keep track of animation frames
UNTIL WndClosed
END
'
'---------------------------------------------------------------------
'Dispose SpriteWorld and Exit
'---------------------------------------------------------------------
'
"STOP"
LONG IF SWOpened
   SWOpened = _False
   FN FatalError(FN SWDisposSpriteWorld(@mySW))
END IF
END
'
"DIALOG"
D0 = DIALOG(0) : DN = DIALOG(D0)
SELECT CASE D0
   CASE _Wndrefresh
      SELECT CASE DN
         CASE _SpriteWnd : FN SWUpdateSpriteWorld(@mySW)
         CASE _StatusWnd : GOSUB "TIMER"
      END SELECT
   CASE _Wndclose
      WndClosed = _Ztrue
   CASE _Wndclick
      IF DN THEN WINDOW DN
END SELECT
RETURN
'
'
'
"MENU"
M0 = MENU(0)
M1=MENU(1)
SELECT CASE M0
   CASE 127 : X = FN ALERT(128,0)                 '••• APPLE MENU •••
   CASE 1                                         '••• FILE MENU •••
      SELECT CASE M1
         CASE 1 : DEF PAGE                        'Page Layout
         CASE 2                                   'Print
            WINDOW OUTPUT _SpriteWnd
            FN PrintWindow(@mySW)
         CASE 4 : WndClosed = _Ztrue              'QUIT
      END SELECT
   CASE 2 : BEEP                                  '••• EDIT MENU •••
END SELECT
MENU
RETURN
'
'
'
"TIMER"
WINDOW OUTPUT _StatusWnd
PrevTime&    = FN TICKCOUNT - LastTime&
elapsedTime& = FN TICKCOUNT - a&
CurrMem&     = SYSTEM(_Memavail)
PRINT @(0,0); USING "#,###,###";frames& ;" frames drawn in ";
LONG IF elapsedTime& < 60000
   PRINT USING "###.#";elapsedTime&/60.  ;" Sec."'Less Than 1000 seconds...
XELSE
   PRINT USING "#,###";elapsedTime&/3600.;" Min."'More Than 1000 seconds...
END IF
PRINT "  Average Frames: ";USING "###.##";frames&\(elapsedTime&\60.)            ;" per second."
PRINT "  Current Frames: ";USING "###.##";(frames&-LastCount&)\(PrevTime&\60.)  ;" per second."
PRINT "     Memory Used: ";USING "##,###,###";OrigMem& - CurrMem&               ;" Bytes."
PRINT "    Memory Avail: ";USING "##,###,###";CurrMem&                          ;" Bytes.";
LastTime&  = FN TICKCOUNT
LastCount& = frames&
RETURN